UNIT UFixUText;


{This unit fixes a bug with UText, where pasting universal text containing a 14 Point or
    20 Pitch font would crash with a check range error, accessing the uvFont array.  The
    only access was made in TInsertionPoint.InsertText.	 To fix the problem we subclass
    TInsertionPoint.InsertText, but install a pointer to the revised method in TInsertionPoint's
    method table.}


{$SETC CalcNumbers := FALSE}	    {IF TRUE, calculate level/method numbers, else use CONSTs}
{$SETC Debug := FALSE}

INTERFACE

{$E ERRORS}
{$E+}

USES
    {$U LIBPL/UCLASCAL}	    UClascal,
    {$U UObject}	    UObject,
    {$U QuickDraw}	    QuickDraw,
    {$U UDraw}		    UDraw,
    {$U UABC}		    UABC,
    {$U UUnivText}	    UTKUniversalText,
    {$U UText}		    UText;

TYPE
    TFixInsertionPoint = SUBCLASS OF TInsertionPoint

        FUNCTION  TFixInsertionPoint.CREATE: TFixInsertionPoint; ABSTRACT;

        PROCEDURE TFixInsertionPoint.InsertText(text: TText; isParaSelection: BOOLEAN;
                                                    isWordSelection: BOOLEAN;
                                                    universalText: BOOLEAN); OVERRIDE;
        END;


IMPLEMENTATION

{$IFC fSymOK AND Debug}
{$D+}
{$ELSEC}
{$D-}
{$ENDC}

{$IFC fDbgOK AND Debug}
{$R+}
{$ELSEC}
{$R-}
{$ENDC}

VAR uvFont:		    ARRAY[1..19] OF TFontRecord;
    cFixInsertionPoint:	    TClass;


{$S FixText1}	    {Caller and HackMethodTable must be in the same segment}
{$IFC CalcNumbers}
PROCEDURE Caller;
    VAR ip:	    TInsertionPoint;
        t:	    TText;
BEGIN
    ip.InsertText(t, TRUE, TRUE, TRUE);
END;
{$ENDC}


PROCEDURE HackMethodTables;
{$IFC CalcNumbers AND DEBUG}
    LABEL   1,100;
{$ELSEC}
    {$IFC CalcNumbers}
    LABEL   100;
    {$ENDC}
    {$IFC Debug}
    LABEL   1;
    {$ENDC}
{$ENDC}

{$IFC NOT CalcNumbers}
    CONST
        levNum	    =   6;
        methNum	    =   2;
{$ENDC}

    TYPE
        TMethodArray = ARRAY [1..256] OF LONGINT;
        TPMethodArray = ^TMethodArray;

        TSliceTable = ARRAY [0..255] OF TPMethodArray;
        TPSliceTable = ^TSliceTable;

    VAR myProc:	        LONGINT;
        {$IFC CalcNumbers}
        pc:	        TpInteger;
        wd:	        INTEGER;
        levNum:	        INTEGER;
        methNum:        INTEGER;
        {$ENDC}
        pSliceTable:    TpSliceTable;

BEGIN
{$IFC Debug}
1:  GOTO 1;
{$ENDC}

{$IFC CalcNumbers}
    {Find out the method # & level # for TInsertionPoint.InsertText}
    pc := TpInteger(@Caller);
    WHILE ORD(pc) <= ORD(@HackMethodTables) DO
        BEGIN
        wd := pc^;
        pc := TpInteger(ORD(pc)+2);
        IF wd = $4E95 THEN {JSR (A5)}
            BEGIN
            wd := pc^;		        {get level/method # as an integer}
            levNum := wd DIV 256;       {these 2 statements only work for <128 levels}
            methNum := wd MOD 256;
{$IFC Debug}
            WriteLn(levNum, methNum); {***}
{$ENDC}
            GOTO 100;
            END;
        END;
    HALT;	    {did not find the method call}
100:
{$ENDC}

    pSliceTable := TpSliceTable(cFixInsertionPoint);
    myProc := pSliceTable^[levNum]^[methNum];

            {The superclass pointers have not been installed yet, so need to use the arrays in UClascal.}
    pSliceTable := TpSliceTable(pSTables^[pClasses^[numClasses].superIndex]);
    pSliceTable^[levNum]^[methNum] := myProc;
END;

METHODS OF TFixInsertionPoint;

{$S FixText2}
    PROCEDURE TFixInsertionPoint.InsertText(text: TText; isParaSelection: BOOLEAN; isWordSelection: BOOLEAN;
                                                                                    universalText: BOOLEAN);
    VAR s:	        TListScanner;
        prevPara:       TEditPara;
        newPara:        TEditPara;
        aParagraph:     TEditPara;
        newLP:	        INTEGER;
        textImage:      TTextImage;
        insertIt:       BOOLEAN;
        done:	        BOOLEAN;
        newParaImage:   TParaImage;
        paraIndex:      LONGINT;
        delta:	        INTEGER;
        numParas:       INTEGER;
        needSpRight:    BOOLEAN;
        {$IFC fUseUnivText}
        readUnivText:   TTKReadUnivText;
        univPara:       TEditPara;
        univFormat:     TParaFormat;
        {$ENDC}

        PROCEDURE StartPaste;
        BEGIN
            {$IFC fTrace}BP(10);{$ENDC}
            IF universalText THEN
                BEGIN
                {$IFC fUseUnivText}
                univFormat := TParaFormat.CREATE(NIL, SELF.Heap, SELF.textImage.text.styleSheet);
                univPara := textImage.NewEditPara(0, prevPara.format);
                readUnivText := TTKReadUnivText.CREATE(NIL, SELF.Heap, NIL, 512,
                                                            [UTCharacters, UTParagraphs]);
                numParas := 0;
                {$ENDC}
                END
            ELSE
                BEGIN
                numParas := text.paragraphs.size;
                s := text.paragraphs.Scanner;
                END;
            {$IFC fTrace}EP;{$ENDC}
        END;

        PROCEDURE EndPaste;
        BEGIN
            {$IFC fTrace}BP(10);{$ENDC}
            IF universalText THEN
                BEGIN
                {$IFC fUseUnivText}
                univPara.Free;
                readUnivText.Free;
                {$ENDC}
                END;
            {$IFC fTrace}EP;{$ENDC}
        END;

        FUNCTION GetParagraph(VAR paragraph: TEditPara): BOOLEAN;
        VAR currPos:	    INTEGER;
            done:	    BOOLEAN;
            runSize:	    INTEGER;
            wasSomeText:    BOOLEAN;
            ch:		    CHAR;
            typeStyle:	    TTypeStyle;
        BEGIN
            {$IFC fTrace}BP(10);{$ENDC}
            If universalText THEN
                BEGIN
                {$IFC fUseUnivText}
                univPara.ReplPString(0, univPara.Size, NIL);
                currPos := 0;
                wasSomeText := FALSE;
                done := FALSE;
                REPEAT
                    readUnivText.ReadRun;
                    runSize := readUnivText.data.size;
                    IF runSize > 0 THEN
                        BEGIN
                        IF NOT wasSomeText THEN
                            BEGIN
                            WITH univFormat, readUnivText.paragraphDescriptor DO
                                BEGIN
                                firstIndent := firstLineMargin;
                                leftIndent := bodyMargin;
                                (* Can't use this because it's given as distance from left rather than
                                   indent from right and I don't know what value of right edge of paper is.
                                rightIndent := rightMargin;
                                *)
                                spaceBelowPara := paraLeading;
                                END;
                            univPara.format := univFormat;
                            END;
                        wasSomeText := TRUE;
                        ch := readUnivText.data.At(runSize);
                        IF ORD(ch) = ascReturn THEN
                            BEGIN
                            readUnivText.data.DelAt(runSize);
                            runSize := runSize - 1;
                            numParas := numParas + 1;
                            done := TRUE;
                            END;
                        univPara.ReplTString(currPos, 0, readUnivText.data, 0, runSize);
                        typeStyle.onFaces := readUnivText.characterDescriptor.face;
                        typeStyle.font.fontFamily := uvFont[readUnivText.characterDescriptor.font].fontFamily;
                        typeStyle.font.fontSize := uvFont[readUnivText.characterDescriptor.font].fontSize;
                        univPara.NewStyle(currPos, currPos+runSize, typeStyle);
                        currPos := currPos + runSize;
                        END
                    ELSE
                        BEGIN
                        IF wasSomeText THEN
                            numParas := numParas + 1;
                        done := TRUE;
                        END;
                UNTIL done;
                IF wasSomeText THEN
                    paragraph := univPara
                ELSE
                    paragraph := NIL;
                GetParagraph := wasSomeText;
                {$ELSEC}
                paragraph := NIL;
                GetParagraph := FALSE;
                {$ENDC}
                END
            ELSE
                GetParagraph := s.Scan(paragraph);
            {$IFC fTrace}EP;{$ENDC}
        END;

        PROCEDURE InsText;
        BEGIN
            {$IFC fTrace}BP(10);{$ENDC}
            delta := 0;
            textImage := SELF.textImage;
            newLP := SELF.textRange.firstLP;
            newPara := SELF.textRange.firstPara;
            prevPara := newPara;
            insertIt := FALSE;

            IF isWordSelection THEN
                BEGIN
                needSpRight := newPara.Qualifies(newLP);
                IF newPara.Qualifies(newLP-1) THEN
                    BEGIN
                    newPara.InsertOneChar(' ', newLP);
                    newLP := newLP + 1;
                    delta := 1;
                    END;
                END;

(*	    {special case: if first paragraph in text is designated a whole paragraph (by isParaSelection) AND
             if the insertion point (SELF) is at the end of the paragraph then we want to make a new
             paragraph rather than append it to the current paragraph and consequently set the flag that
             was supposed to prevent the first paragraph from being inserted}
            IF isParaSelection AND (prevPara.size = newLP) THEN
                BEGIN
                newPara := textImage.NewEditPara(0, prevPara.format);
                newLP := 0;
                insertIt := TRUE;
                END;
*)
            done := FALSE;
            StartPaste;
            IF GetParagraph(aParagraph) THEN
                BEGIN
                delta := delta + aParagraph.size;
                REPEAT
                newPara.ReplPara(newLP, 0, aParagraph, 0, aParagraph.size);
                newLP := newLP + aParagraph.size;
                IF insertIt THEN
                    textImage.text.InsParaAfter(prevPara, newPara);
                insertIt := TRUE;
                prevPara := newPara;
                IF GetParagraph(aParagraph) THEN
                    BEGIN
                    newPara := textImage.NewEditPara(prevPara.size-newLP,
                                                        TParaFormat(aParagraph.format.Clone(SELF.Heap)));
                    {For now, so we don't get garbage (if aParagraph later deleted), put cloned
                     format on to styleSheet list}
                    SELF.textImage.text.styleSheet.formats.InsLast(newPara.format);
                    newPara.StartEdit(newPara.GrowSize);
                    newPara.ReplPara(0, 0, prevPara, newLp, prevPara.size - newLp);
                    prevPara.ReplPString(newLp, prevPara.size-newLP, NIL);
                    prevPara.StopEdit;
                    newLP := 0;
                    END
                 ELSE
                    done := TRUE;
                UNTIL done;
                END;

            IF isParaSelection THEN
                BEGIN
                newPara := textImage.NewEditPara(prevPara.size - newLP, prevPara.format);
                newPara.StartEdit(newPara.GrowSize);
                newPara.ReplPara(0, 0, prevPara, newLp, prevPara.size - newLp);
                prevPara.ReplPString(newLp, prevPara.size - newLP, NIL);
                prevPara.StopEdit;
                textImage.text.InsParaAfter(prevPara, newPara);
                newPara := TEditPara(textImage.text.paragraphs.At(SELF.textRange.firstIndex + numParas));
                numParas := numParas+1;
                newLP := 0;
                END
            ELSE IF isWordSelection THEN
                IF needSpRight THEN
                    BEGIN
                    newPara.InsertOneChar(' ', newLP);
                    newLP := newLP + 1;
                    delta := delta + 1;
                    END;

            EndPaste;
            {$IFC fTrace}EP;{$ENDC}
        END;

        PROCEDURE Adjust;
            PROCEDURE AddDelta(paraImage: TParaImage);
            BEGIN
                paraImage.AdjustLineLPs(SELF.textRange.firstLP, delta);
            END;
        BEGIN
            {$IFC fTrace}BP(10);{$ENDC}
            SELF.textRange.firstPara.EachImage(AddDelta);

            WITH SELF, textRange DO
                BEGIN
                firstPara := newPara;
                lastPara := newPara;
                firstLP := newLP;
                lastLP := newLP;
                firstIndex := firstIndex + numParas - 1;
                lastIndex := firstIndex;
                newestLP := newLP;
                amTyping := FALSE;
                END;
            {$IFC fTrace}EP;{$ENDC}
        END;
    BEGIN
        {$IFC fTrace}BP(11);{$ENDC}
        IF (text <> NIL) OR universalText THEN
            SELF.ChangeText(InsText, Adjust);
        {$IFC fTrace}EP;{$ENDC}
    END;

{$S FixText1}
BEGIN
    cFixInsertionPoint := THISCLASS;

    HackMethodTables;

    uvFont[4].fontFamily := famModern;
    uvFont[5].fontFamily := famModern;
    uvFont[6].fontFamily := famModern;
    uvFont[7].fontFamily := famModern;
    uvFont[8].fontFamily := famModern;
    uvFont[9].fontFamily := famModern;
    uvFont[10].fontFamily := famClassic;
    uvFont[11].fontFamily := famClassic;
    uvFont[12].fontFamily := famClassic;
    uvFont[13].fontFamily := famClassic;
    uvFont[14].fontFamily := famClassic;
    uvFont[15].fontFamily := famModern;	        {added}
    uvFont[16].fontFamily := famClassic;        {added}
    uvFont[19].fontFamily := famModern;	        {added}
    uvFont[4].fontSize := 5;
    uvFont[5].fontSize := 7;
    uvFont[6].fontSize := 8;
    uvFont[7].fontSize := 2;
    uvFont[8].fontSize := 3;
    uvFont[9].fontSize := 4;
    uvFont[10].fontSize := 5;
    uvFont[11].fontSize := 7;
    uvFont[12].fontSize := 8;
    uvFont[13].fontSize := 3;
    uvFont[14].fontSize := 6;
    uvFont[15].fontSize := 6;		        {added}
    uvFont[16].fontSize := 6;		        {added}
    uvFont[19].fontSize := 1;		        {added}
END;


END.

